home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / usenet / sources / volume90 / aplictns / xscheme2 / part01 / xscheme.ini < prev   
Text File  |  1990-04-14  |  1KB  |  61 lines
  1. ; xscheme.ini - initialization code for XScheme version 0.16
  2.  
  3. (load "macros.s")
  4. (load "qquote.s")
  5.  
  6. ; this version of EVAL knows about the optional enviroment parameter
  7. (define (eval x #!optional env)
  8.   ((if (default-object? env)
  9.      (compile x)
  10.      (compile x env))))
  11.  
  12. (define (autoload-from-file file syms #!optional env)
  13.   (map (lambda (sym) (put sym '%autoload file)) syms)
  14.   '())
  15.   
  16. (define (*unbound-handler* sym cont)
  17.   (let ((file (get sym '%autoload)))
  18.     (if file (load file))
  19.     (if (not (bound? sym))
  20.       (error "unbound variable" sym))
  21.     (cont '())))
  22.  
  23. (define head car)
  24. (define (tail x) (force (cdr x)))
  25. (define empty-stream? null?)
  26. (define the-empty-stream '())
  27.  
  28. (macro cons-stream
  29.   (lambda (x)
  30.     (list 'cons (cadr x) (list 'delay (caddr x)))))
  31.  
  32. (macro make-environment
  33.   (lambda (x)
  34.     (append '(let ()) (cdr x) '((the-environment)))))
  35.  
  36. (define initial-user-environment (the-environment))
  37.  
  38. (macro case
  39.   (lambda (form)
  40.     (let ((test (cadr form))
  41.           (sym (gensym)))
  42.       `(let ((,sym ,test))
  43.          (cond ,@(map (lambda (x)
  44.                         (if (eq? (car x) 'else)
  45.                           x
  46.                           `((memv ,sym ',(car x)) ,@(cdr x))))
  47.                       (cddr form)))))))
  48. (define writeln
  49.     (lambda (#!OPTIONAL ovar . rvar)
  50.         (if (not (default-object? ovar))
  51.             (begin
  52.                 (display ovar)
  53.                 (while (not (null? rvar))
  54.                     (display (car rvar))
  55.                     (set! rvar (cdr rvar))
  56.                     )
  57.                 ))
  58.         (newline)))
  59.  
  60. (load "mystuff.s")
  61.